home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 016 / tdsnap2.arc / TDSNAP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-09-28  |  6.7 KB  |  269 lines
  1. {$C-}
  2. Program TDSnap;
  3. const
  4.  Our_Char = 113;
  5.  Quit_Key = 119;
  6.  User_Int = $67;
  7.  Kybrd_Int = $16;
  8. Type
  9.  Regtype = record Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Flags:integer end;
  10.  HalfRegtype = record Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh:byte end;
  11. Const
  12.  Regs : regtype = (Ax:0;Bx:0;Cx:0;Dx:0;Bp:0;Si:0;Di:0;Ds:0;Es:0;Flags:0);
  13.  OurDseg : integer = 0;
  14.  OurSseg : integer = 0;
  15.  DosSseg : integer = 0;
  16.  Inuse : Boolean = false;
  17.  User_IntIP : integer = 0;
  18.  User_IntCs : integer = 0;
  19. Var
  20.  SaveRegs : regtype;
  21.  HalfRegs : halfregtype absolute regs;
  22.  Terminate_flag : boolean ;
  23.  Keychr : char ;
  24. (*========================= Begin User Variables ===========================*)
  25.  
  26. Type
  27.    String80   = String[80];
  28. Const
  29.    NameOut : String[80] = 'TDSNAP.TXT';
  30.    VideoEnable = $08;                  { Video Signal Enable Bit        }
  31. Var
  32.    CGAScreen       : Array [1..4000] of char absolute $B800:0000;
  33.    MonoScreen      : Array [1..4000] of char absolute $B000:0000;
  34.    FileOut         : Text;             { Output text file               }
  35.    LineOut         : String[80];       { Output text line               }
  36.    NonSpace        : Byte;             { Index of last non-space        }
  37.    RIx             : Byte;             { Row Index into screen          }
  38.    CIx             : Byte;             { Col Index into screen          }
  39.    Video_Buffer    : Integer;
  40.  
  41.    Crtmode     :byte      absolute $0040:$0049;
  42.    Crtwidth    :byte      absolute $0040:$004A;
  43.    CrtAdapter  :integer   absolute $0040:$0063; { Current Display Adapter }
  44.    VideoMode   :byte      absolute $0040:$0065; { Video Port Mode byte    }
  45.  
  46. (*========================== End User Variables ============================*)
  47. {---------------------------------- Exist -------------------------------------}
  48. {                                                                              }
  49. {   Given a file name, this function returns true if the file exists           }
  50. {                                                                              }
  51. Function Exist(FileName: String80): boolean;
  52. Var FileVar: file;
  53. Begin
  54.    {$I-}
  55.    Assign(FileVar,FileName);
  56.    Reset(FileVar);
  57.    If IOResult = 0 then
  58.       Exist := true
  59.    else
  60.       Exist := false;
  61.    Close(FileVar);
  62.    {$I+}
  63. End;
  64.  
  65. Procedure Stay_Xit;
  66. Begin
  67.  Writeln ('TDSnap Returning memory to DOS') ;
  68.  SaveRegs.Ax := $35 shl 8 + User_Int;
  69.  MsDos(SaveRegs);
  70.  SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
  71.  SaveRegs.Ds := SaveRegs.Es;
  72.  SaveRegs.Dx := SaveRegs.Bx;
  73.  MsDos(SaveRegs);
  74.  MemW[$00:User_Int * 4] := 0 ;
  75.  MemW[$00:User_Int * 4 + 2] :=0;
  76.  Saveregs.Ax := $49 shl 8 + 0 ;
  77.  Saveregs.Es := MemW[Cseg:$2C] ;
  78.  MsDos( Saveregs ) ;
  79.  Saveregs.Ax := $49 shl 8 + 0 ;
  80.  Saveregs.Es := Cseg ;
  81.  MsDos( Saveregs ) ;
  82.  Intr($20,Regs) ;
  83. End;
  84. Procedure Process_Intr;
  85. Begin
  86.  Inline (
  87.  $80/$FC/$00/
  88.  $74/$07/
  89.  $5D/$5D/
  90.  $2E/
  91.  $FF/$2E/User_IntIP/
  92.  $FA /
  93.  $55/
  94.  $BD/Regs/
  95.  $2E/$89/$46/$00/
  96.  $2E/$89/$5E/$02/
  97.  $2E/$89/$4E/$04/
  98.  $2E/$89/$56/$06/
  99.  $2E/$8F/$46/$08/
  100.  $2E/$89/$76/$0A/
  101.  $2E/$89/$7E/$0C/
  102.  $2E/$8C/$5E/$0E/
  103.  $2E/$8C/$46/$10/
  104.  $9C/
  105.  $2E/$8F/$46/$12/
  106.  $2E/$80/$3E/Inuse/$01/
  107.  $74/$57/
  108.  $2E/$8C/$16/DosSSeg/
  109.  $8C/$D6/
  110.  $8E/$C6/
  111.  $2E/$8E/$16/OurSSeg/
  112.  $2E/$8E/$1E/OurDseg/
  113.  $2E/$3B/$36/OurSSeg/
  114.  $89/$E6/
  115.  $74/$05/
  116.  $3E/$8B/$36/$74/$01/
  117.  $87/$F4/
  118.  $2E/$FF/$76/$00/
  119.  $2E/$FF/$76/$02/
  120.  $2E/$FF/$76/$04/
  121.  $2E/$FF/$76/$06/
  122.  $2E/$FF/$76/$0A/
  123.  $2E/$FF/$76/$0C/
  124.  $2E/$FF/$76/$0E/
  125.  $2E/$FF/$76/$10/
  126.  $B9/>$0028/
  127.  $26/$FF/$34/
  128.  $46/$46/
  129.  $E2/$F9/
  130.  $2E/$8E/$16/OurSSeg/
  131.  $56/
  132.  $2E/$8C/$5E/$0E/
  133.  $FB
  134.  ) ;
  135.  Intr (User_Int, Regs);
  136.  If (Halfregs.Ah = Quit_Key) then
  137.  stay_xit
  138.  else
  139.  If (Halfregs.Ah = Our_Char)
  140.  then if (not InUse) then
  141.  Begin
  142.  InUse := true;
  143. (*============================ Begin User Code =============================*)
  144. (*
  145.    Port[CrtAdapter+4] := (VideoMode - VideoEnable);   { Disable video }
  146. *)
  147.    If CrtMode = 7 then
  148.       Video_Buffer := $B000
  149.    else
  150.       Video_Buffer := $B800;
  151.  
  152.    Assign(FileOut,NameOut);
  153.    If Exist(NameOut) then
  154.    begin
  155.       Append(FileOut);
  156.       FillChar(LineOut,80,'-');
  157.       LineOut[0] := Chr(80);
  158.       WriteLn(FileOut,LineOut);
  159.    end
  160.    else
  161.       ReWrite(FileOut);
  162.    For RIx := 1 to 25 do
  163.    begin
  164.       NonSpace := 0;
  165.       For CIx := 1 to 80 do
  166.       begin
  167.          LineOut[CIx] := Chr(Mem[Video_Buffer: ((RIx-1)*160)+((CIx-1)*2)]);
  168.          If LineOut[CIx] <> ' ' then
  169.             NonSpace := CIx;
  170.       end;
  171.       LineOut[0] := Chr(NonSpace);
  172.       WriteLn(FileOut,LineOut);
  173.    end;
  174.    Close(FileOut);
  175. (*
  176.    Port[CrtAdapter+4] := (VideoMode or VideoEnable);
  177. *)
  178.  
  179. (*============================= End User Code ==============================*)
  180.  Regs.Ax := $1D00;
  181.  InUse := false;
  182.  End;
  183.  inline(
  184.  $BD/Regs/
  185.  $2E/$8B/$46/$00/
  186.  $2E/$8B/$5E/$02/
  187.  $2E/$8B/$4E/$04/
  188.  $2E/$8B/$56/$06/
  189.  $2E/$8B/$76/$0A/
  190.  $2E/$8B/$7E/$0C/
  191.  $2E/$8E/$5E/$0E/
  192.  $2E/$8E/$46/$10/
  193.  $2E/$FF/$76/$12/
  194.  $9D/
  195.  $2E/$80/$3E/Inuse/$01/
  196.  $74/$23/
  197.  $FA /
  198.  $5E/
  199.  $B9/>$0028/
  200.  $2E/$8E/$06/DosSSeg/
  201.  $4E/$4E/
  202.  $26/$8F/$04/
  203.  $E2/$F9/
  204.  $89/$F5/
  205.  $07/
  206.  $1F/
  207.  $5F/
  208.  $5E/
  209.  $5A/
  210.  $59/
  211.  $5B/
  212.  $44/$44/
  213.  $89/$EC/
  214.  $2E/$8E/$16/DosSSeg/
  215.  $5D/
  216.  $BD/Regs/
  217.  $2E/$FF/$76/$12/
  218.  $9D/
  219.  $5D/
  220.  $FB/
  221.  $CA/$02/$00
  222.  );
  223. End;
  224. Begin
  225. (*=============================== User Code ================================*)
  226.    If ParamCount > 0 then
  227.       NameOut := ParamStr(1);
  228. (*=============================== User Code ================================*)
  229.  InUse := false;
  230.  OurDseg:= Dseg;
  231.  OurSseg:= Sseg;
  232.  Terminate_Flag := false ;
  233.  SaveRegs.Ax := $35 shl 8 + User_Int;
  234.  Intr($21,SaveRegs);
  235.  if SaveRegs.Es <> $00 then
  236.  WriteLn ('Interrupt in use -- can''t install TDSnap as Resident Code')
  237.  else
  238.  begin
  239.  SaveRegs.Ax := $35 shl 8 + Kybrd_Int;
  240.  Intr($21,SaveRegs);
  241.  SaveRegs.Ax := $25 shl 8 + User_Int;
  242.  SaveRegs.Ds := SaveRegs.Es;
  243.  SaveRegs.Dx := SaveRegs.Bx;
  244.  Intr($21,SaveRegs);
  245.  SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
  246.  SaveRegs.Ds := Cseg;
  247.  SaveRegs.Dx := Ofs(Process_Intr);
  248.  Intr ($21,SaveRegs);
  249.  User_IntIp := MemW[0:User_Int * 4 ];
  250.  User_IntCs := MemW[0:User_Int * 4 +2];
  251. (*=============================== User Code ================================*)
  252.    TextColor(14);
  253.    TextBackGround(1);
  254.    ClrScr;
  255.    GotoXY(32,2);  Write('Saxman Software');
  256.    GotoXY(31,3);  Write('Tools Disk Series');
  257.    GotoXY(33,4);  Write('Program TDPRT');
  258.    TextColor(7);
  259.    WriteLn(''); WriteLn(''); WriteLn('');
  260.    Writeln('  TDSnap Memory Resident.');
  261.    WriteLn('  Press Alt-F10 to write snapshot to "',NameOut,'"');
  262.    WriteLn('  Press Ctrl-Home to un-install.');
  263. (*=============================== User Code ================================*)
  264.  SaveRegs.Ax := $31 shl 8 + 0 ;
  265.  SaveRegs.Dx := MemW [Cseg-1:0003] ;
  266.  Intr ($21,SaveRegs);
  267.  end;
  268. end.
  269.